home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / File_Shred68621442002.psc / File Shredder / FBButton.ctl < prev    next >
Encoding:
Visual Basic user-defined control file  |  2002-04-04  |  27.6 KB  |  808 lines
  1. VERSION 5.00
  2. Begin VB.UserControl FlatButton 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   1395
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   1365
  8.    KeyPreview      =   -1  'True
  9.    MouseIcon       =   "FBButton.ctx":0000
  10.    MousePointer    =   99  'Custom
  11.    ScaleHeight     =   93
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   91
  14.    ToolboxBitmap   =   "FBButton.ctx":0152
  15.    Begin VB.PictureBox picBuffer 
  16.       Appearance      =   0  'Flat
  17.       AutoRedraw      =   -1  'True
  18.       BorderStyle     =   0  'None
  19.       ForeColor       =   &H80000008&
  20.       Height          =   240
  21.       Left            =   120
  22.       ScaleHeight     =   240
  23.       ScaleWidth      =   240
  24.       TabIndex        =   2
  25.       Top             =   480
  26.       Visible         =   0   'False
  27.       Width           =   240
  28.    End
  29.    Begin VB.PictureBox picImage 
  30.       Appearance      =   0  'Flat
  31.       BackColor       =   &H00FFFFFF&
  32.       BorderStyle     =   0  'None
  33.       ForeColor       =   &H80000008&
  34.       Height          =   240
  35.       Left            =   120
  36.       ScaleHeight     =   240
  37.       ScaleWidth      =   240
  38.       TabIndex        =   1
  39.       Top             =   120
  40.       Visible         =   0   'False
  41.       Width           =   240
  42.    End
  43.    Begin VB.Timer tmrHighlight 
  44.       Enabled         =   0   'False
  45.       Interval        =   200
  46.       Left            =   120
  47.       Top             =   840
  48.    End
  49.    Begin VB.Label lblCaption 
  50.       Alignment       =   2  'Center
  51.       AutoSize        =   -1  'True
  52.       BackStyle       =   0  'Transparent
  53.       Caption         =   "lblCaption"
  54.       Height          =   195
  55.       Left            =   480
  56.       TabIndex        =   0
  57.       Top             =   120
  58.       Width           =   690
  59.    End
  60. End
  61. Attribute VB_Name = "FlatButton"
  62. Attribute VB_GlobalNameSpace = False
  63. Attribute VB_Creatable = True
  64. Attribute VB_PredeclaredId = False
  65. Attribute VB_Exposed = False
  66. Option Explicit
  67.  
  68.  
  69.  
  70. '========================================================================
  71. 'Windows API Types
  72. '========================================================================
  73. Private Type POINTAPI
  74.     x As Long
  75.     y As Long
  76. End Type
  77.  
  78. Private Type RECT
  79.     Left As Long
  80.     Top As Long
  81.     Right As Long
  82.     Bottom As Long
  83. End Type
  84.  
  85. '========================================================================
  86. 'Windows API Declarations
  87. '========================================================================
  88. Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint _
  89. As Long, ByVal yPoint As Long) As Long
  90. Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) _
  91. As Long
  92. Private Declare Function DrawEdge Lib "user32.dll" (ByVal hdc As Long, _
  93. qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
  94. Private Declare Function DrawFocusRect Lib "user32.dll" (ByVal hdc As Long, _
  95. lpRect As RECT) As Long
  96. Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC As Long, _
  97. ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As _
  98. Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, _
  99. ByVal dwRop As Long) As Long
  100.     
  101. '========================================================================
  102. 'Enumerations
  103. '========================================================================
  104. Public Enum fbAlignment
  105.     fbLeft = 0
  106.     fbRight
  107.     fbCenter
  108. End Enum
  109.     
  110. '========================================================================
  111. 'Constants
  112. '========================================================================
  113. Private Const BDR_RAISEDINNER As Long = &H4
  114. Private Const BDR_SUNKENOUTER As Long = &H2
  115. Private Const BDR_RAISED = &H5
  116. Private Const BDR_SUNKEN = &HA
  117. Private Const BDR_MOUSEOVER As Long = BDR_RAISEDINNER
  118. Private Const BDR_MOUSEDOWN As Long = BDR_SUNKENOUTER
  119. Private Const BDR_MOUSEOVER_HB As Long = BDR_RAISED
  120. Private Const BDR_MOUSEDOWN_HB As Long = BDR_SUNKEN
  121. Private Const BF_BOTTOM As Long = &H8
  122. Private Const BF_LEFT As Long = &H1
  123. Private Const BF_RIGHT As Long = &H4
  124. Private Const BF_TOP As Long = &H2
  125. 'Bitwise comparison
  126. Private Const BF_RECT As Long = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  127. Private Const DUD_VALUE As Integer = -1
  128. Private Const NOT_APPLY_ALL As Integer = 0
  129. Private Const APPLY_ALL As Integer = 1
  130. Private Const INIT_PROP_FLAG As Integer = 0
  131. Private Const READ_PROP_FLAG As Integer = 1
  132. Private Const FORCE_FLATTEN As Integer = 1
  133. Private Const FOCUS_RECT_OFFSET As Integer = 4
  134.     
  135. Private Const mDef_lngForeColor As Long = vbBlack
  136. Private Const mDef_lngBackColor As Long = vbButtonFace
  137. Private Const mDef_lngHoverColor As Long = vbHighlight
  138. Private Const mDef_fbAlignment As Integer = fbAlignment.fbCenter
  139. Private Const mDef_booHasBorder As Boolean = False
  140. Private Const mDef_strCaption As String = "FlatButton"
  141. Private Const mDef_booEnabled As Boolean = True
  142. Private Const mDef_booHasFocusRect As Boolean = True
  143. Private Const mDef_booAlignPicLeft As Boolean = True
  144. Private Const mDef_intPictureWidth As Integer = 16
  145. Private Const mDef_intPictureHeight As Integer = mDef_intPictureWidth
  146. Private Const mDef_lngPicturehDC As Long = 0
  147. Private Const mDef_booHasPicture As Boolean = False
  148. Private Const mDef_booHasCaption As Boolean = True
  149.     
  150. Private Const FORECOLOR_PROPERTY_NAME As String = "ForeColor"
  151. Private Const ALIGNMENT_PROPERTY_NAME As String = "Alignment"
  152. Private Const HOVERCOLOR_PROPERTY_NAME As String = "HoverColor"
  153. Private Const ENABLED_PROPERTY_NAME As String = "Enabled"
  154. Private Const FONT_PROPERTY_NAME As String = "Font"
  155. Private Const HASFOCUSRECT_PROPERTY_NAME As String = "HasFocusRect"
  156. Private Const CAPTION_PROPERTY_NAME As String = "Caption"
  157. Private Const BACKCOLOR_PROPERTY_NAME As String = "BackColor"
  158. Private Const HASBORDER_PROPERTY_NAME As String = "HasBorder"
  159. Private Const ALIGNPICLEFT_PROPERTY_NAME As String = "AlignPicLeft"
  160. Private Const PICTUREWIDTH_PROPERTY_NAME As String = "PictureWidth"
  161. Private Const PICTUREHEIGHT_PROPERTY_NAME As String = "PictureHeight"
  162. Private Const HASPICTURE_PROPERTY_NAME As String = "HasPicture"
  163. Private Const HASCAPTION_PROPERTY_NAME As String = "HasCaption"
  164. Private Const PICTUREHDC_PROPERTY_NAME As String = "PicturehDC"
  165.     
  166. '========================================================================
  167. 'Variables
  168. '========================================================================
  169. Private mprop_lngForeColor As Long
  170. Private mProp_lngHoverColor As Long
  171. Private mProp_lngBackColor As Long
  172. Private mProp_fbAlignment As fbAlignment
  173. Private mProp_booHasBorder As Boolean
  174. Private mProp_strCaption As String
  175. Private mProp_booEnabled As Boolean
  176. Private mProp_booHasFocusRect As Boolean
  177. Private mProp_fntFont As StdFont
  178. Private mProp_booAlignPicLeft As Boolean
  179. Private mProp_intPictureHeight As Integer
  180. Private mProp_intPictureWidth As Integer
  181. Private mProp_lngPicturehDC As Long
  182. Private mProp_booHasPicture As Boolean
  183. Private mProp_booHasCaption As Boolean
  184.  
  185. Private mbooHasCapture As Boolean
  186. Private mpntLabelPos As POINTAPI
  187. Private mpntOldSize As POINTAPI
  188. Private mpntPicPos As POINTAPI
  189. Private intPropertiesKnown As Integer
  190.  
  191. Event Click()
  192.  
  193. '========================================================================
  194. 'UserControl Enter/Exit Focus
  195. '========================================================================
  196. Private Sub UserControl_EnterFocus()
  197.  
  198. Dim rctFocus As RECT
  199.  
  200. If Not mProp_booHasFocusRect Then Exit Sub
  201.  
  202. 'Draw a focus rectangle
  203. rctFocus.Left = FOCUS_RECT_OFFSET
  204. rctFocus.Top = FOCUS_RECT_OFFSET
  205. rctFocus.Right = ScaleWidth - FOCUS_RECT_OFFSET
  206. rctFocus.Bottom = ScaleHeight - FOCUS_RECT_OFFSET
  207. DrawFocusRect hdc, rctFocus
  208.  
  209. End Sub
  210.  
  211. Private Sub UserControl_ExitFocus()
  212. 'Remove the focus rectangle
  213. If mProp_booHasFocusRect Then Line (FOCUS_RECT_OFFSET, FOCUS_RECT_OFFSET)- _
  214. (ScaleWidth - FOCUS_RECT_OFFSET - 1, ScaleHeight - FOCUS_RECT_OFFSET - 1), _
  215. mProp_lngBackColor, B
  216. End Sub
  217.  
  218. '========================================================================
  219. 'UserControl Initialize/InitProprties
  220. '========================================================================
  221. Private Sub UserControl_Initialize()
  222. tmrHighlight.Enabled = False
  223. tmrHighlight.Interval = 100
  224. End Sub
  225.  
  226. Private Sub UserControl_InitProperties()
  227.  
  228. UserControl.Width = 1095
  229. UserControl.Height = 390
  230.  
  231. mprop_lngForeColor = mDef_lngForeColor
  232. mProp_fbAlignment = mDef_fbAlignment
  233. mProp_booAlignPicLeft = mDef_booAlignPicLeft
  234. mProp_intPictureWidth = mDef_intPictureWidth
  235. mProp_intPictureHeight = mDef_intPictureHeight
  236. mProp_lngPicturehDC = mDef_lngPicturehDC
  237. mProp_booHasCaption = mDef_booHasCaption
  238. mProp_booHasPicture = mDef_booHasPicture
  239. mProp_booHasBorder = mDef_booHasBorder
  240. mProp_lngBackColor = mDef_lngBackColor
  241. mProp_strCaption = mDef_strCaption
  242. mProp_booEnabled = mDef_booEnabled
  243. mProp_booHasFocusRect = mDef_booHasFocusRect
  244. mProp_lngHoverColor = mDef_lngHoverColor
  245.  
  246. Set mProp_fntFont = Ambient.Font
  247. intPropertiesKnown = 1
  248.  
  249. ApplyAllProperties INIT_PROP_FLAG
  250.  
  251. End Sub
  252.  
  253. '========================================================================
  254. 'UserControl Property Bag Stuff
  255. '========================================================================
  256. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  257.  
  258. With PropBag
  259.     mprop_lngForeColor = .ReadProperty(FORECOLOR_PROPERTY_NAME, mDef_lngForeColor)
  260.     mProp_fbAlignment = .ReadProperty(ALIGNMENT_PROPERTY_NAME, mDef_fbAlignment)
  261.     mProp_booAlignPicLeft = .ReadProperty(ALIGNPICLEFT_PROPERTY_NAME, mDef_booAlignPicLeft)
  262.     mProp_intPictureWidth = .ReadProperty(PICTUREWIDTH_PROPERTY_NAME, mDef_intPictureWidth)
  263.     mProp_intPictureHeight = .ReadProperty(PICTUREHEIGHT_PROPERTY_NAME, mDef_intPictureHeight)
  264.     mProp_lngPicturehDC = .ReadProperty(PICTUREHDC_PROPERTY_NAME, mDef_lngPicturehDC)
  265.     mProp_booHasPicture = .ReadProperty(HASPICTURE_PROPERTY_NAME, mDef_booHasPicture)
  266.     mProp_booHasCaption = .ReadProperty(HASCAPTION_PROPERTY_NAME, mDef_booHasCaption)
  267.     mProp_booHasBorder = .ReadProperty(HASBORDER_PROPERTY_NAME, mDef_booHasBorder)
  268.     mProp_lngBackColor = .ReadProperty(BACKCOLOR_PROPERTY_NAME, mDef_lngBackColor)
  269.     mProp_strCaption = .ReadProperty(CAPTION_PROPERTY_NAME, mDef_strCaption)
  270.     mProp_booEnabled = .ReadProperty(ENABLED_PROPERTY_NAME, mDef_booEnabled)
  271.     mProp_booHasFocusRect = .ReadProperty(HASFOCUSRECT_PROPERTY_NAME, mDef_booHasFocusRect)
  272.     Set mProp_fntFont = .ReadProperty(FONT_PROPERTY_NAME, Ambient.Font)
  273.     mProp_lngHoverColor = .ReadProperty(HOVERCOLOR_PROPERTY_NAME, mDef_lngHoverColor)
  274. End With
  275.  
  276. intPropertiesKnown = 1
  277.  
  278. ApplyAllProperties READ_PROP_FLAG
  279.  
  280. If Ambient.UserMode Then 'Runtime only
  281.     If mProp_booHasBorder Then
  282.         ApplyBorder FORCE_FLATTEN
  283.     End If
  284.     tmrHighlight.Enabled = True
  285. End If
  286.  
  287. End Sub
  288.  
  289. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  290. With PropBag
  291.     .WriteProperty FORECOLOR_PROPERTY_NAME, mprop_lngForeColor, mDef_lngForeColor
  292.     .WriteProperty ALIGNMENT_PROPERTY_NAME, mProp_fbAlignment, mDef_fbAlignment
  293.     .WriteProperty ALIGNPICLEFT_PROPERTY_NAME, mProp_booAlignPicLeft, mDef_booAlignPicLeft
  294.     .WriteProperty PICTUREWIDTH_PROPERTY_NAME, mProp_intPictureWidth, mDef_intPictureWidth
  295.     .WriteProperty PICTUREHEIGHT_PROPERTY_NAME, mProp_intPictureHeight, mDef_intPictureHeight
  296.     .WriteProperty PICTUREHDC_PROPERTY_NAME, mProp_lngPicturehDC, mDef_lngPicturehDC
  297.     .WriteProperty HASPICTURE_PROPERTY_NAME, mProp_booHasPicture, mDef_booHasPicture
  298.     .WriteProperty HASCAPTION_PROPERTY_NAME, mProp_booHasCaption, mDef_booHasCaption
  299.     .WriteProperty HASBORDER_PROPERTY_NAME, mProp_booHasBorder, mDef_booHasBorder
  300.     .WriteProperty BACKCOLOR_PROPERTY_NAME, mProp_lngBackColor, mDef_lngBackColor
  301.     .WriteProperty CAPTION_PROPERTY_NAME, mProp_strCaption, mDef_strCaption
  302.     .WriteProperty ENABLED_PROPERTY_NAME, mProp_booEnabled, mDef_booEnabled
  303.     .WriteProperty HASFOCUSRECT_PROPERTY_NAME, mProp_booHasFocusRect, mDef_booHasFocusRect
  304.     .WriteProperty FONT_PROPERTY_NAME, mProp_fntFont, Ambient.Font
  305.     .WriteProperty HOVERCOLOR_PROPERTY_NAME, mProp_lngHoverColor, mDef_lngHoverColor
  306. End With
  307. End Sub
  308.  
  309. '========================================================================
  310. 'Key Events
  311. '========================================================================
  312. Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
  313. RaiseEvent Click
  314. End Sub
  315.  
  316. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  317. If KeyAscii = vbKeySpace Or KeyAscii = vbKeyReturn Then
  318.     RaiseEvent Click
  319. End If
  320. End Sub
  321.  
  322. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  323. If KeyCode = vbKeySpace Or KeyCode = vbKeyReturn Then
  324.     UserControl_MouseDown vbLeftButton, DUD_VALUE, DUD_VALUE, DUD_VALUE
  325. End If
  326. End Sub
  327.  
  328. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  329. If KeyCode = vbKeySpace Or KeyCode = vbKeyReturn Then
  330.     UserControl_MouseUp DUD_VALUE, DUD_VALUE, DUD_VALUE, DUD_VALUE
  331. End If
  332. End Sub
  333.  
  334. '========================================================================
  335. 'MouseDown Events
  336. '========================================================================
  337. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  338.  
  339. Const OFFSET As Integer = 1
  340. Dim rctBtn As RECT
  341.  
  342. If Button = vbLeftButton Then
  343.     tmrHighlight.Enabled = False
  344.     lblCaption.Left = mpntLabelPos.x + OFFSET
  345.     lblCaption.Top = mpntLabelPos.y + OFFSET
  346.     picImage.Move mpntPicPos.x + OFFSET, mpntPicPos.y + OFFSET, _
  347.     picImage.Width, picImage.Height
  348.     Line (0, 0)-(Width, Height), mProp_lngBackColor, B
  349.     rctBtn.Left = 0
  350.     rctBtn.Top = 0
  351.     rctBtn.Right = ScaleWidth
  352.     rctBtn.Bottom = ScaleHeight
  353.     If mProp_booHasBorder = True Then
  354.         DrawEdge hdc, rctBtn, BDR_MOUSEDOWN_HB, BF_RECT
  355.     Else
  356.         DrawEdge hdc, rctBtn, BDR_MOUSEDOWN, BF_RECT
  357.     End If
  358. End If
  359.  
  360. End Sub
  361.  
  362. Private Sub lblCaption_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  363. UserControl_MouseDown Button, Shift, x, y
  364. End Sub
  365.  
  366. Private Sub picImage_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  367. UserControl_MouseDown Button, Shift, x, y
  368. End Sub
  369.  
  370. '========================================================================
  371. 'MouseUp Events
  372. '========================================================================
  373. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  374.  
  375. Dim pntCursor As POINTAPI
  376.  
  377. lblCaption.Left = mpntLabelPos.x
  378. lblCaption.Top = mpntLabelPos.y
  379. picImage.Move mpntPicPos.x, mpntPicPos.y, picImage.Width, picImage.Height
  380. GetCursorPos pntCursor
  381. If WindowFromPoint(pntCursor.x, pntCursor.y) = hwnd Or _
  382. WindowFromPoint(pntCursor.x, pntCursor.y) = picImage.hwnd Or _
  383. mProp_booHasBorder Then
  384.     ApplyBorder
  385.     mbooHasCapture = True
  386. Else
  387.     Line (0, 0)-(ScaleWidth - 1, ScaleHeight - 1), mProp_lngBackColor, B
  388.     mbooHasCapture = False
  389. End If
  390.  
  391. tmrHighlight.Enabled = True
  392.  
  393. RaiseEvent Click
  394.  
  395. End Sub
  396.  
  397. Private Sub lblCaption_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  398. UserControl_MouseUp Button, Shift, x, y
  399. End Sub
  400.  
  401. Private Sub picImage_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  402. UserControl_MouseUp Button, Shift, x, y
  403. End Sub
  404.  
  405. '========================================================================
  406. 'Other UserControl Events
  407. '========================================================================
  408. Private Sub UserControl_Resize()
  409.  
  410. If intPropertiesKnown = 0 Then Exit Sub
  411.  
  412. Cls
  413. RedrawControl
  414.  
  415. 'Design-time or Has Border
  416. If Not Ambient.UserMode Or mProp_booHasBorder Then
  417.     ApplyBorder FORCE_FLATTEN
  418. End If
  419.  
  420. End Sub
  421.  
  422. Private Sub UserControl_AmbientChanged(PropertyName As String)
  423. If UCase$(PropertyName) = "BACKCOLOR" Then
  424.     BackColor = Ambient.BackColor
  425. End If
  426. End Sub
  427.  
  428. '========================================================================
  429. 'Other Object Events
  430. '========================================================================
  431. Private Sub picImage_Paint()
  432.  
  433. If mProp_booEnabled = True Then
  434.     'Draw picture
  435.     BitBlt picImage.hdc, 0, 0, mProp_intPictureWidth, _
  436.     mProp_intPictureHeight, mProp_lngPicturehDC, 0, 0, vbSrcCopy
  437. Else
  438.     'Draw picture (incase button begins its life disabled)
  439.     BitBlt picImage.hdc, 0, 0, mProp_intPictureWidth, _
  440.     mProp_intPictureHeight, mProp_lngPicturehDC, 0, 0, vbSrcCopy
  441.     'Draw dimmed (darker) picture
  442.     BitBlt picImage.hdc, 0, 0, mProp_intPictureWidth, _
  443.     mProp_intPictureHeight, picBuffer.hdc, 0, 0, vbSrcAnd
  444. End If
  445.  
  446. End Sub
  447.  
  448. Private Sub tmrHighlight_Timer()
  449.  
  450. Dim pntCursor As POINTAPI
  451.  
  452. GetCursorPos pntCursor
  453.  
  454. 'If mouse is over this control
  455. If WindowFromPoint(pntCursor.x, pntCursor.y) = hwnd Or _
  456. WindowFromPoint(pntCursor.x, pntCursor.y) = picImage.hwnd Then
  457.     If Not mbooHasCapture Then
  458.         ApplyBorder
  459.         lblCaption.ForeColor = mProp_lngHoverColor
  460.         mbooHasCapture = True
  461.     End If
  462. Else
  463.     If mbooHasCapture Then
  464.         'Remove thick edge
  465.         Line (0, 0)-(ScaleWidth - 1, ScaleHeight - 1), mProp_lngBackColor, B
  466.         lblCaption.ForeColor = mprop_lngForeColor
  467.         mbooHasCapture = False
  468.     End If
  469. End If
  470.  
  471. End Sub
  472.  
  473. '========================================================================
  474. 'Properties requiring Apply**** to be called
  475. '========================================================================
  476. Public Property Get HasBorder() As Boolean
  477. Attribute HasBorder.VB_Description = "Sets/returns whether the FlatButton is drawn with a border at runtime."
  478.     HasBorder = mProp_booHasBorder
  479. End Property
  480.  
  481. Public Property Let HasBorder(ByVal booNewValue As Boolean)
  482. If Ambient.UserMode Then 'Design-time only
  483.     Err.Raise 383
  484. Else
  485.     mProp_booHasBorder = booNewValue
  486.     PropertyChanged HASBORDER_PROPERTY_NAME
  487. End If
  488. End Property
  489.  
  490. Public Property Get BackColor() As OLE_COLOR
  491. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  492. BackColor = mProp_lngBackColor
  493. End Property
  494.  
  495. Public Property Let BackColor(ByVal oleNewValue As OLE_COLOR)
  496. mProp_lngBackColor = oleNewValue
  497. ApplyBackColor
  498. ApplyBorder
  499. PropertyChanged BACKCOLOR_PROPERTY_NAME
  500. End Property
  501.  
  502. Public Property Get Alignment() As fbAlignment
  503. Attribute Alignment.VB_Description = "Returns/sets the FlatButton control's caption alignment."
  504. Alignment = mProp_fbAlignment
  505. End Property
  506.  
  507. Public Property Let Alignment(ByVal fbNewValue As fbAlignment)
  508. mProp_fbAlignment = fbNewValue
  509. ApplyCaption
  510. PropertyChanged ALIGNMENT_PROPERTY_NAME
  511. End Property
  512.  
  513. Public Property Get Caption() As String
  514. Attribute Caption.VB_Description = "Returns/sets the text displayed in an object's title bar or below an object's icon."
  515. Caption = mProp_strCaption
  516. End Property
  517.  
  518. Public Property Let Caption(ByVal strNewValue As String)
  519. mProp_strCaption = strNewValue
  520. ApplyCaption
  521. PropertyChanged CAPTION_PROPERTY_NAME
  522. End Property
  523.  
  524. Public Property Get HasFocusRect() As Boolean
  525. Attribute HasFocusRect.VB_Description = "Read-only at runtime. Set/returns whether a focus rectangle is drawn on the FlatButton when it has focus."
  526. HasFocusRect = mProp_booHasFocusRect
  527. End Property
  528.  
  529. Public Property Let HasFocusRect(ByVal booNewValue As Boolean)
  530. If Ambient.UserMode Then 'Design-time only
  531.     Err.Raise 383
  532. Else
  533.     mProp_booHasFocusRect = booNewValue
  534.     PropertyChanged HASFOCUSRECT_PROPERTY_NAME
  535. End If
  536. End Property
  537.  
  538. Public Property Get Font() As StdFont
  539. Attribute Font.VB_Description = "Returns a Font object."
  540. Set Font = mProp_fntFont
  541. End Property
  542.  
  543. Public Property Set Font(ByVal fntNewValue As StdFont)
  544. Set mProp_fntFont = fntNewValue
  545. ApplyFont
  546. PropertyChanged FONT_PROPERTY_NAME
  547. End Property
  548.  
  549. Public Property Get Enabled() As Boolean
  550. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  551. Attribute Enabled.VB_UserMemId = -514
  552. Enabled = mProp_booEnabled
  553. End Property
  554.  
  555. Public Property Let Enabled(ByVal booNewValue As Boolean)
  556. mProp_booEnabled = booNewValue
  557. ApplyEnabled
  558. PropertyChanged ENABLED_PROPERTY_NAME
  559. End Property
  560.  
  561. Public Property Get HoverColor() As OLE_COLOR
  562. Attribute HoverColor.VB_Description = "Returns/sets the color of the FlatButton caption text when the mouse pointer is over the control."
  563. HoverColor = mProp_lngHoverColor
  564. End Property
  565.  
  566. Public Property Let HoverColor(ByVal oleNewValue As OLE_COLOR)
  567. mProp_lngHoverColor = oleNewValue
  568. PropertyChanged HOVERCOLOR_PROPERTY_NAME
  569. End Property
  570.  
  571. Public Property Get ForeColor() As OLE_COLOR
  572. Attribute ForeColor.VB_Description = "Returns/sets the FlatButtons foreground color which is used to display the button caption."
  573. ForeColor = mprop_lngForeColor
  574. End Property
  575.  
  576. Public Property Let ForeColor(ByVal oleNewValue As OLE_COLOR)
  577. mprop_lngForeColor = oleNewValue
  578. ApplyCaption
  579. PropertyChanged FORECOLOR_PROPERTY_NAME
  580. End Property
  581.  
  582. '========================================================================
  583. 'Properties requiring UserControl_Resize to be called
  584. '========================================================================
  585. Public Property Get HasPicture() As Boolean
  586. Attribute HasPicture.VB_Description = "Returns/sets whether a picture is used on the FlatButton."
  587. HasPicture = mProp_booHasPicture
  588. End Property
  589.  
  590. Public Property Let HasPicture(ByVal booNewValue As Boolean)
  591. mProp_booHasPicture = booNewValue
  592. PropertyChanged HASPICTURE_PROPERTY_NAME
  593. UserControl_Resize
  594. End Property
  595.  
  596. Public Property Get HasCaption() As Boolean
  597. Attribute HasCaption.VB_Description = "Returns/sets whether a text caption is used on the FlatButton."
  598. HasCaption = mProp_booHasCaption
  599. End Property
  600.  
  601. Public Property Let HasCaption(ByVal booNewValue As Boolean)
  602. mProp_booHasCaption = booNewValue
  603. PropertyChanged HASCAPTION_PROPERTY_NAME
  604. UserControl_Resize
  605. End Property
  606.  
  607. Public Property Get AlignPicLeft() As Boolean
  608. Attribute AlignPicLeft.VB_Description = "Specifies whether to align the FlatButton's picture to the left hand side of the button."
  609. AlignPicLeft = mProp_booAlignPicLeft
  610. End Property
  611.  
  612. Public Property Let AlignPicLeft(ByVal booNewValue As Boolean)
  613. mProp_booAlignPicLeft = booNewValue
  614. PropertyChanged ALIGNPICLEFT_PROPERTY_NAME
  615. UserControl_Resize
  616. End Property
  617.  
  618. Public Property Get PicturehDC() As Long
  619. Attribute PicturehDC.VB_Description = "Returns/sets the handle to a device context used as the source device context for the FlatButton picture."
  620. PicturehDC = mProp_lngPicturehDC
  621. End Property
  622.  
  623. Public Property Let PicturehDC(ByVal lngNewValue As Long)
  624. mProp_lngPicturehDC = lngNewValue
  625. PropertyChanged PICTUREHDC_PROPERTY_NAME
  626. UserControl_Resize
  627. End Property
  628.  
  629. Public Property Get PictureHeight() As Integer
  630. Attribute PictureHeight.VB_Description = "Returns/sets the height in pixels of the source device context."
  631. PictureHeight = mProp_intPictureHeight
  632. End Property
  633.  
  634. Public Property Let PictureHeight(ByVal intNewValue As Integer)
  635. mProp_intPictureHeight = intNewValue
  636. PropertyChanged PICTUREHEIGHT_PROPERTY_NAME
  637. UserControl_Resize
  638. End Property
  639.  
  640. Public Property Get PictureWidth() As Integer
  641. Attribute PictureWidth.VB_Description = "Returns/sets the width in pixels of the source device context."
  642. PictureWidth = mProp_intPictureWidth
  643. End Property
  644.  
  645. Public Property Let PictureWidth(ByVal intNewValue As Integer)
  646. mProp_intPictureWidth = intNewValue
  647. PropertyChanged PICTUREWIDTH_PROPERTY_NAME
  648. UserControl_Resize
  649. End Property
  650.  
  651. '========================================================================
  652. 'Private Subroutines
  653. '========================================================================
  654. Private Sub RedrawControl()
  655.  
  656. Dim intX As Integer
  657. Dim intLabelTop As Integer
  658. Dim intBadPicSizeFlag As Integer
  659.  
  660. 'Check that the picture has a valid size
  661. If mProp_booHasPicture = True Then
  662.     If mProp_intPictureWidth = 0 Or mProp_intPictureHeight = 0 Then
  663.         intBadPicSizeFlag = 1
  664.         mProp_booHasPicture = False 'Temporarily disable
  665.     Else
  666.         picImage.Width = mProp_intPictureWidth
  667.         picImage.Height = mProp_intPictureHeight
  668.         picBuffer.Width = mProp_intPictureWidth
  669.         picBuffer.Height = mProp_intPictureWidth
  670.     End If
  671. End If
  672.  
  673. lblCaption.AutoSize = True
  674. intLabelTop = (ScaleHeight / 2) - (lblCaption.Height / 2)
  675.  
  676. picImage.Top = (ScaleHeight / 2) - (picImage.Height / 2)
  677.  
  678. intX = (ScaleWidth - picImage.Width - lblCaption.Width) / 3
  679.  
  680. If mProp_booHasPicture = True And mProp_booHasCaption = True Then
  681.  
  682.     lblCaption.Top = intLabelTop
  683.  
  684.     If mProp_booAlignPicLeft = False Then
  685.         picImage.Left = intX
  686.         lblCaption.Visible = True
  687.         lblCaption.Left = 2 * intX + picImage.Width
  688.     Else
  689.         picImage.Left = 6
  690.         lblCaption.Visible = True
  691.         lblCaption.Left = 6 + picImage.Width + _
  692.         (ScaleWidth - 6 - picImage.Width - lblCaption.Width) / 2
  693.     End If
  694.     
  695.     picImage.Visible = True
  696.     picImage_Paint
  697.  
  698. ElseIf mProp_booHasPicture = False And mProp_booHasCaption = True Then
  699.     
  700.     lblCaption.AutoSize = False
  701.     lblCaption.Move 5, intLabelTop, ScaleWidth - 10, ScaleHeight
  702.     lblCaption.Visible = True
  703.     
  704.     picImage.Visible = False
  705.  
  706. ElseIf mProp_booHasPicture = True And mProp_booHasCaption = False Then
  707.     
  708.     lblCaption.Visible = False
  709.     picImage.Left = (ScaleWidth / 2) - (picImage.Width / 2)
  710.     
  711.     picImage.Visible = True
  712.     picImage_Paint
  713.  
  714. Else
  715.     
  716.     picImage.Visible = False
  717.     lblCaption.Visible = False
  718.  
  719. End If
  720.  
  721. 'Restore the HasPicture property if required
  722. If intBadPicSizeFlag = 1 Then mProp_booHasPicture = True
  723.  
  724. mpntLabelPos.x = lblCaption.Left
  725. mpntLabelPos.y = lblCaption.Top
  726. mpntPicPos.x = picImage.Left
  727. mpntPicPos.y = picImage.Top
  728. mpntOldSize.x = ScaleWidth
  729. mpntOldSize.y = ScaleHeight
  730.  
  731. End Sub
  732.  
  733. Private Sub ApplyAllProperties(ByVal intCallFlag As Integer)
  734. ApplyBackColor
  735. ApplyCaption APPLY_ALL
  736. ApplyFont APPLY_ALL
  737. ApplyEnabled APPLY_ALL
  738. If intCallFlag = READ_PROP_FLAG Then UserControl_Resize
  739. End Sub
  740.  
  741. Private Sub ApplyBackColor()
  742. UserControl.BackColor = mProp_lngBackColor
  743. End Sub
  744.  
  745. Private Sub ApplyCaption(Optional ByVal intApplyAll As Integer = NOT_APPLY_ALL)
  746.  
  747. Dim lngA As Long
  748.  
  749. AccessKeys = ""
  750.  
  751. For lngA = Len(mProp_strCaption) To 1 Step -1
  752.     If Mid$(mProp_strCaption, lngA, 1) = "&" Then
  753.         If lngA = 1 Then
  754.             AccessKeys = Mid$(mProp_strCaption, lngA + 1, 1)
  755.         ElseIf Not Mid$(mProp_strCaption, lngA - 1, 1) = "&" Then
  756.             AccessKeys = Mid$(mProp_strCaption, lngA + 1, 1)
  757.             Exit For
  758.         Else
  759.             lngA = lngA - 1
  760.         End If
  761.     End If
  762. Next
  763.  
  764. With lblCaption
  765.     .Caption = mProp_strCaption
  766.     .Alignment = mProp_fbAlignment
  767.     .ForeColor = mprop_lngForeColor
  768. End With
  769.  
  770. If intApplyAll = NOT_APPLY_ALL Then UserControl_Resize
  771.  
  772. End Sub
  773.  
  774. Private Sub ApplyFont(Optional ByVal intApplyAll As Integer = NOT_APPLY_ALL)
  775. Set UserControl.Font = mProp_fntFont
  776. Set lblCaption.Font = mProp_fntFont
  777. If intApplyAll = NOT_APPLY_ALL Then UserControl_Resize
  778. End Sub
  779.  
  780. Private Sub ApplyEnabled(Optional ByVal intApplyAll As Integer = NOT_APPLY_ALL)
  781. lblCaption.Enabled = mProp_booEnabled
  782. UserControl.Enabled = mProp_booEnabled
  783. If mProp_booHasPicture = True Then
  784.     If intApplyAll = NOT_APPLY_ALL Then UserControl_Resize
  785. End If
  786. End Sub
  787.  
  788. Private Sub ApplyBorder(Optional ByVal intFirstApply As Integer = 0)
  789. Dim rctBtn As RECT
  790. Line (0, 0)-(Width, Height), mProp_lngBackColor, B
  791. rctBtn.Left = 0
  792. rctBtn.Top = 0
  793. rctBtn.Right = ScaleWidth
  794. rctBtn.Bottom = ScaleHeight
  795. If mProp_booHasBorder = True Then
  796.     DrawEdge hdc, rctBtn, BDR_MOUSEOVER_HB, BF_RECT
  797.     If intFirstApply = FORCE_FLATTEN Or Not Ambient.UserMode Then
  798.         'Remove thick edge
  799.         Line (0, 0)-(ScaleWidth - 1, ScaleHeight - 1), mProp_lngBackColor, B
  800.     End If
  801. Else
  802.     DrawEdge hdc, rctBtn, BDR_MOUSEOVER, BF_RECT
  803. End If
  804. End Sub
  805.  
  806.  
  807.  
  808.